perm filename DOER[AP,SYS]2 blob
sn#013863 filedate 1972-11-27 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00016 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00003 00002 Definitions.
00006 00003 Storage allocations.
00011 00004 Start of main program (DOER). Prepare to read in uncataloged story from 'NEWS' file.
00016 00005 Read in undun story. Check sequence nbr for digest, etc.
00020 00006 For each word in story, collect its letters.
00023 00007 Check current word for indicator of a correction, an add, or a take.
00028 00008 Find appropriate place in sorted list for current word.
00032 00009 Open INDEX and DICT files. Read in WORDS and LINKS files.
00034 00010 Look for keywords in story. Link up any that are found.
00037 00011 Link up keyword in story.
00043 00012 Write out new versions of files.
00048 00013 Subroutines: RDDICT, GTDICT, PAUSE1-4, DIGEST, DONTDO, GONE.
00053 00014 Subroutines: ERROR.
00055 00015 Write error message on a file with the time, month, and day.
00058 00016 Interrupt level module: INTRPT, CHGNAM.
00060 ENDMK
⊗;
;Definitions.
TITLE DOER
; ACCUMULATOR ASSIGNMENTS
A←1 ;temporary AC
B←2 ;temporary AC
C←3 ;temporary AC
AVAIL←←3 ;pointer to an available link block in LINKS
WD←4 ;the word being looked at in the sorted list
PREV←←4
DICTWD←5 ;pointer to the current dictionary entry
FIRST←6 ;ptr to text of current dictionary word
AC1←←7 ;temporary AC
AC2←←10 ;temporary AC
SORPTR←7 ;pointer to current entry in the sorted list (SORDID)
TXTPTR←10 ;byte pointer for depositing letters into TEXT area
PART1←←11 ;four ac's for holding the (possible) 4 words per
PART2←←12 ; entry in the sorted list. Used in comparison.
PART3←←13
PART4←←14
CHAR←11 ;current character of story
DISPL←12
SIZE←13
BPTR←15 ;byte pointer into buffer holding current story
LWD←16 ;the last word looked at in the sorted list
P←17
LF←←12
CR←←15
NKEYS←←=20 ;max nbr of keywords all starting with same word
PDLEN←←=30 ;length of push down list
SPECS←←4 ;number of special words at front of INDEX file
XSIZE←←3 ;size of the index entry for one story
MAXNBR←←=500 ;maximum number of stories allowed
XLEN←MAXNBR*XSIZE+SPECS ;total size of space for index entries
LLEN←←10000
WLEN←←6400
DEFINE UNDUN {INDEX} ;first word in INDEX file
DEFINE NEW {INDEX+1} ;second word
DEFINE OLD {INDEX+2} ;third word
;ERRMSG causes an error message to be added to the ERRORS file. Then
; the SWAP UUO is called to start up a fresh version of DOER.
DEFINE ERRMSG(MSG)
{PUSHJ P,[ SETZM XITFLG
MOVEM A,SAVEDA
MOVEI A,[ASCIZ \ DOER: MSG
\]
JRST ERROR]}
;ERRXIT causes an error message to be added to the ERRORS file. Then
; the program EXITs.
DEFINE ERRXIT(MSG)
{PUSHJ P,[ SETOM XITFLG
MOVEM A,SAVEDA
MOVEI A,[ASCIZ \ DOER: MSG
\]
JRST ERROR]}
EXTERNAL JOBAPR,JOBCNI
;Storage allocations.
NEWSF: SIXBIT /NEWS/ ;block for LOOKUP and ENTER for NEWS file
BLOCK 3
INDEXF: SIXBIT /INDEX/ ;block for LOOKUP and ENTER for INDEX file
BLOCK 3
LINKSF: SIXBIT /LINKS/ ;block for LOOKUP and ENTER for LINKS file
BLOCK 3
DICTF: SIXBIT /DICT/ ;block for LOOKUP and ENTER for DICT file
BLOCK 3
WORDSF: SIXBIT /WORDS/ ;block for LOOKUP for WORDS file
BLOCK 3
ERRORF: SIXBIT /ERRORS/;block for LOOKUP and ENTER for ERRORS file
BLOCK 3
STORY: BLOCK 2200 ;buffer to hold stories
INDEX: BLOCK XLEN ;core array for holding index pointers for stories
LINKS: BLOCK LLEN ;holds the assorted relationships for words found in DICT
DICT: BLOCK 400 ;holds two records of the dictionary, 1 reg and 1 mults
WORDS: BLOCK WLEN ;holds the words actually pointed to in DICT
SORDID: BLOCK =600 ;holds the sorted list of words in a story
TEXT: BLOCK =1500 ;holds the characters of the words in the story
PDLIST: BLOCK PDLEN ;push down list
KEYS: BLOCK NKEYS ;ptrs to dictionary entries for keywords categorizing story
ERRBFI: BLOCK 3 ;buffer header for input buffer for copying old error msgs
ERRBFO: BLOCK 3 ;buffer header for output buffer for writing out error msgs
CMD: IOWD 1,STORY ;command for reading in a story to be cataloged
0
XCMD: IOWD XLEN,INDEX ;command for reading/writing INDEX
0
LCMD: IOWD LLEN,LINKS ;command for reading/writing LINKS
0
DCMD: IOWD 200,DICT ;command for reading/writing DICT
0
MCMD: IOWD 200,DICT+200 ;command for reading/writing a mult rec of DICT
0
WCMD: IOWD WLEN,WORDS ;command for reading WORDS
0
DSK17: 17 ;block for OPENing the DSK in mode 17 many times
SIXBIT /DSK/
0
SWAPBK: SIXBIT /DSK/
SIXBIT /DOER/
SIXBIT /DMP/
0
SIXBIT / APSYS/
NAME: SIXBIT /[DOER]/ ;name DOER uses while running
WRDCNT: 0
DICPTR: 0 ;pointer to the current dictionary entry
DICREC: 0 ;number of the current record of DICT that is in core
MLTPTR: 0 ;negated ptr to DICT entry for current mult word key
MLTREC: 0 ;number of the current mult rec of DICT that is in core
GUDREC: 0 ;number of current mult rec that needs to be in core
WRFLAG: 0 ;flag indicating whether the DICREC must be written out
LKOVFL: 0 ;LINKS space overflow flag
LOSEQ: 0 ;lowest acceptable seq nbr for earlier take
HISEQ: 0 ;highest acceptable seq nbr for earlier take
SPBPTR: 0 ;special byte ptr
MISSIN: 0 ;flag indicating if story sought in NEWS was found
NRDOER: 0 ;code indicating number of other DOERs
TTYLIN: 0 ;word for indicating whether DOER is detached
SAVEDA: 0 ;word for storing accumulator A upon an error
XITFLG: 0 ;flag indicating whether DOER should exit after writing error file
TAKEFG: 0 ;flag indicating whether current story is first of TAKES
STCNT: 0 ;word for number of stories we have yet to look for earlier take
CATFLG: 0 ;flag indicating whether current word has been used to categorize the story
LEN: 0 ;pseudo length of a story word
CHCNT: 0 ;character count for the UNDUN story
CATNBR: 0 ;nbr of similar keywords categorizing story
;Start of main program (DOER). Prepare to read in uncataloged story from 'NEWS' file.
DOER: MOVEI A,INTRPT ;get address of interrupt level module
MOVEM A,JOBAPR ;store it in JOBAPR
MOVE A,[400200000] ;enable for interrupts on parity errors and
CALL A,[SIXBIT /INTENB/]; pdl ov
MOVEI A,200000
CALL A,[SIXBIT /INTGEN/];generate a pdl ov interrupt to set the job name
MOVE A,NRDOER ;get code nbr indicating number of other DOERs
JRST .+2(A)
ERRXIT {ONE OTHER DOER ALREADY EXISTED WHEN DOER STARTED UP (0)}
ERRXIT {TWO OR MORE DOERS EXISTED WHEN DOER STARTED UP (1)}
AGAIN3: OPEN 1,DSK17 ;get the index file
ERRXIT {OPEN FAILED ON DSK (2)}
SETZM INDEXF+3
LOOKUP 1,INDEXF ;INDEX file
JRST PAUSE3
IN 1,XCMD ;read in INDEX file
JRST .+2
ERRXIT {IN UUO FAILED DURING ATTEMPT TO READ IN INDEX FILE (4)}
RELEAS 1, ;INDEX file
MOVE P,[INITPD: IOWD PDLEN,PDLIST];init the stack ptr
MOVE B,UNDUN ;grab UNDUN from the INDEX file
MORE: CAMN B,NEW ;has UNDUN caught up with NEW?
CALL [SIXBIT /EXIT/] ;yes. exit (releasing the job since jlog is probably not set)
;check if UNDUN points to a story that has been deleted or otherwise wiped out
DOMORE: MOVE A,OLD ;get index of OLD story and compare with
CAMG A,NEW ; index of NEW area
JRST OLDLES ;OLD index is above (less than) NEW index
CAML B,NEW ;NEW index is above (less than) OLD index.
CAML B,OLD ;is UNDUN between OLD and NEW?
JRST DOMOR1 ;no. everything is ok.
OLDUN: MOVEM A,UNDUN ;make the oldest story the first undun one
MOVE B,A
JRST DOMOR1
OLDLES: CAML B,OLD ;OLD index is above (less than) NEW index
CAML B,NEW ;is UNDUN between OLD and NEW?
JRST OLDUN ;no! UNDUN story seems to have been deleted (or something)
;calculate the size of the UNDUN story using its position and that of the next story
DOMOR1: MOVE SIZE,B
ADDI SIZE,XSIZE
CAIL SIZE,XLEN
MOVEI SIZE,SPECS
MOVN SIZE,INDEX+1(SIZE)
ADD SIZE,INDEX+1(B)
JUMPL SIZE,ONWARD
DOWN: MOVN SIZE,INDEX+3 ;UNDUN story is last in NEWS. get ptr to end of NEWS
ADD SIZE,INDEX+1(B)
ONWARD: ASH SIZE,-13 ;right adjust the negated size of the UNDUN story
OUTSTR [ASCIZ / STORY! /]
HRRZ DISPL,INDEX+1(B);get displacement of UNDUN story
ASH DISPL,-13 ;right-adjust displacement
MOVN A,DISPL ;make displacement negative (size is already negative)
ADD A,SIZE ;calculate length of NEWS stuff to be read in
HRLM A,CMD ;put length in the command word
SETZM LINKS+1 ;clear the back ptr to slots for this story
SETZM MISSIN ;clear flag that would indicate story was not found
SETZM TAKEFG ;clear flag that would indicate first of several takes
;Read in undun story. Check sequence nbr for digest, etc.
AGAIN1: OPEN 0,DSK17 ;prepare to read the NEWS file
ERRXIT {OPEN FAILED ON DSK (6)}
SETZM NEWSF+3
LOOKUP 0,NEWSF ;NEWS file
JRST PAUSE1 ;can't read NEWS...FILER is writing it
HLRZ A,INDEX+1(B) ;get record number for UNDUN story
USETI 0,(A)
IN 0,CMD ;input the UNDUN story into STORY
JRST .+2
ERRXIT {IN UUO FAILED DURING ATTEMPT TO READ IN NEWS STORY (8)}
RELEAS 0, ;NEWS file
MOVEI BPTR,STORY-1(DISPL) ;point byte pointer at first word of story
HRLI BPTR,700 ;initialize byte pointer
MOVE TXTPTR,[POINT 7,TEXT-1,34] ;initialize byte ptr to start of TEXT
MOVE A,SIZE ;put number of chars in story into CNT by
ASH A,2 ; multiplying size by 5
ADD A,SIZE
MOVEM A,CHCNT ;store number of chars
MOVEI SORPTR,1 ;initialize SORPTR to start of SORDID
MOVEI B,3 ;prepare to look for 3 digits of sequence nbr
SETZ C,
NXTDG: ILDB A,BPTR ;get a char from first word of story
CAIG A,"9" ;is it a digit?
CAIGE A,"0"
JRST GONE ;no!
IMULI C,=10 ;yes. multiply sum of previous digits by =10
ADDI C,-60(A) ;add in current digit
SOJG B,NXTDG ;got all 3 digits of seq nbr?
ILDB A,BPTR ;yes. get char after the 3 digits
CAIE A,CR ;does CR follow the digits?
JRST GONE ;no!
ILDB A,BPTR ;yes
CAIE A,LF ;does LF follow the CR?
JRST GONE ;no!
MOVE B,UNDUN
HRRZ A,INDEX+2(B) ;GET SUPPOSED SEQ NBR OF STORY
CAME C,A ;DOES STORY IN NEWS HAVE CORRECT SEQ NBR?
JRST GONE ;NO!
MOVEM C,HISEQ ;SAVE SEQ NBR OF CURRENT STORY
CAIN C,1 ;is this the story just before the PMS digest?
JRST DONTDO ;yes
CAIN C,2 ;is this the PMS digest (story 002)?
JRST DIGEST ;yes
CAIN C,=201 ;is this the story just before the AMS digest?
JRST DONTDO ;yes
CAIN C,=202 ;is this the AMS digest (story 202)?
JRST DIGEST ;yes
;For each word in story, collect its letters.
MOVEI A,=35 ;number of words at the front of the story that
MOVEM A,WRDCNT ; are checked for special meanings
SETZM SORDID ;zero the header for the sorted list
MOVEI 0,100 ;load 100 for storing bytes containing @'s
BETW: AOSLE CHCNT ;begin reading characters until a letter is hit or
JRST READ ; there are no more characters
ILDB CHAR,BPTR ;get next character from story
CAIL CHAR,"A"
JRST LTR
CAIL CHAR,"0" ;character is not a letter
CAILE CHAR,"9" ;is it a digit?
JRST BETW ;no
JRST CONT ;yes
LTR2: TRZ CHAR,40 ;make all letters upper case
JRST MIDDL
LTR: TRZ CHAR,40 ;make all letters upper case
CONT: MOVEM TXTPTR,SORDID(SORPTR);store byte ptr to TEXT of this new word
MIDDL: IDPB CHAR,TXTPTR ;deposit this letter in TEXT
AOSLE CHCNT ;any more chars in story?
JRST DEP100 ;no
ILDB CHAR,BPTR ;yes, get one
CAIL CHAR,"A"
JRST LTR2 ;it's a letter
CAIGE CHAR,"0" ;it's not a letter
JRST DEP100 ;nor a digit
CAIG CHAR,"9"
JRST MIDDL ;it is a digit and the word goes on
DEP100: IDPB 0,TXTPTR ;end of word...fill out text word with @'s
TLNE TXTPTR,760000
JRST DEP100
HRRZ A,SORDID(SORPTR);get ptr to beginning of current word
MOVE PART1,1(A) ;move word to PARTS for comparison for sorting
MOVE PART2,2(A)
MOVE PART3,3(A)
MOVE PART4,4(A)
;Check current word for indicator of a correction, an add, or a take.
SOSGE WRDCNT ;is current word among first 20 words of story?
JRST ON ;no
CAMN PART1,[ASCII /TAKES/] ;is story the first of several takes?
JRST [SETOM TAKEFG ;yes. mark it so
JRST ON]
CAMN PART1,[ASCII /TAKE@/] ;is story possibly a take of an earlier story?
JRST TAKE ;yes
TDNE PART1,[372010040000] ;is current word possibly a seq nbr?
JRST ON ;no
SETCA PART1, ;yes
TDNE PART1,[405406030000] ;check appropriate bits for 1's
JRST GOON ;not a seq nbr
SETCA PART1,
;is a seq nbr.
LDB B,[POINT 7,PART1,13] ;AC B WILL HOLD THE REFERENCED SEQ NBR IN BINARY
SUBI B,60 ;CONVERT 1ST DIGIT TO BINARY FROM ASCII
IMULI B,=10
LDB C,[POINT 7,PART1,20]
ADDI B,-60(C) ;ADD IN 2ND DIGIT OF SEQ NBR
IMULI B,=10
LDB C,[POINT 7,PART1,27]
ADDI B,-60(C) ;ADD IN 3RD DIGIT OF SEQ NBR
MOVE PREV,UNDUN ;prepare to look up index entry for prev story
MOVEI A,=200 ;max nbr of stories back we are willing to look
NXPREV: SOJL A,ON ;have we check max nbr of stories already?
SUBI PREV,XSIZE ;no. get index of the previous story
CAIGE PREV,SPECS
MOVEI PREV,XLEN-XSIZE
HRRZ C,INDEX+2(PREV) ;GET SEQ NBR OF THIS PREVIOUS STORY
CAME B,C ;IS THE PREV STORY THE ONE REFERRED TO?
JRST NXPREV ;no
LINKEM: OPEN 7,DSK17 ;grab INDEX file
ERRXIT {OPEN FAILED ON DSK (10)}
SETZM INDEXF+1
SETZM INDEXF+2
SETZM INDEXF+3
ENTER 7,INDEXF
JRST [RELEAS 7,
MOVEI A,2
CALL A,[SIXBIT /SLEEP/]
JRST LINKEM]
JRST FINISH
GOON: SETCA PART1, ;re-complement PART1 back to normal
JRST ON ; and go on
TAKE: MOVEM BPTR,SPBPTR ;copy the (byte) ptr into the story
TAK1: ILDB CHAR,SPBPTR ;get next char from story
CAIN CHAR,"t" ;is it a "t" (as in "two")?
JRST TAK9
CAIL CHAR,"A" ;is it a letter?
JRST ON
CAIL CHAR,"0" ;no.
CAILE CHAR,"9" ;is it a digit?
JRST TAK1 ;no. get next char
TAK9: MOVE PREV,UNDUN ;yes. we have, eg: take 2
SETOM TAKEFG ;set take flag in case cant find original take
HRREI A,-6 ;number of stories back we are willing
MOVEM A,STCNT ; to look for the earlier take
ADD A,HISEQ
MOVEM A,LOSEQ ;SAVE MIN SEQ NBR WE CAN ACCEPT FOR EARLIER TAKE
TAK8: SUBI PREV,XSIZE ;get index of the previous story
CAIGE PREV,SPECS ; so that we can link current
MOVEI PREV,XLEN-XSIZE ; story with the previous one,
HRRZ A,INDEX+2(PREV) ; which should be an earlier
CAML A,LOSEQ ; take of the same story.
CAMLE A,HISEQ ;IS SEQ NBR OF THIS PREV STORY IN RIGHT RANGE?
JRST GETNXT ;NO. GET NEXT PREV STORY.
HRRE C,INDEX(PREV) ;YES. IS THIS PREV STORY A TAKE?
AOJE C,LINKEM ;IF SO, LINK IT UP TO THE CURRENT STORY
GETNXT: AOSGE STCNT ;HAVE WE EXAMINED LIMIT OF PREV STORIES?
JRST TAK8 ;NO. TRY THE NEXT PREV STORY.
;Find appropriate place in sorted list for current word.
ON: MOVE A,SORDID(SORPTR);retrieve byte ptr into TEXT for current word
SUB A,TXTPTR ;get length of word
HRLM A,SORDID(SORPTR);save length of this word
CAMGE A,[-4] ;is word longer than 20 letters?
HRREI A,-4 ;yes. ignore all but first 20 letters
MOVEM A,LEN ;save pseudo length of this word (max = 4)
SETZ LWD, ;LWD points to the last examined word in the list
NEXT: HLRZ WD,SORDID(LWD) ;get pointer from LWD to next WD
TRZ WD,700000 ;zero out length bits that were in the pointer
JUMPE WD,INSERT ;if null pointer, insert word at end of list
HRRZ FIRST,SORDID(WD);get pointer from WD to text (characters) of word
MOVE A,LEN ;load A with length of current word (in words)
CAME PART1,1(FIRST) ;method of comparison: compare first parts.
JRST CHECK1 ; If unequal, jump out. Otherwise, if
AOJGE A,INSERT ; there is still part of the word left,
CAME PART2,2(FIRST) ; continue comparing.If the word is the
JRST CHECK2 ; same as an existing word, go to INSERT to
AOJGE A,INSERT ; insert it again.
CAME PART3,3(FIRST)
JRST CHECK3
AOJGE A,INSERT
CHECK4: CAMG PART4,4(FIRST) ;note that we only need one CAM for the last part (PART4)
JRST INSERT
JRST ADVNCE
CHECK3: CAMG PART3,3(FIRST) ;if it is greater, then you want to continue checking.
JRST INSERT ;if it is less, you want to insert it where you are
JRST ADVNCE ;advance the pointers.
CHECK2: CAMG PART2,2(FIRST)
JRST INSERT
JRST ADVNCE
CHECK1: CAMG PART1,1(FIRST)
JRST INSERT
ADVNCE: MOVE LWD,WD ;the new LWD is the old WD
JRST NEXT ;continue down list looking for place to insert current word
;insert next word into list of previously sorted words.
INSERT: HLRZ A,SORDID(SORPTR);retrieve the size of current word
ASH A,17 ;move the size to the left hand bits of AC right
ADD A,WD ;put the link in the low order bits of AC right
HRLM A,SORDID(SORPTR);store the length and link of the new word
HLRZ A,SORDID(LWD) ;get the length and link of LWD
TRZ A,77777 ;zero the link
ADD A,SORPTR ;add in the new link
HRLM A,SORDID(LWD) ;store the length and new link of LWD
ADDI SORPTR,1 ;increment SORPTR to next word not yet sorted
JRST BETW
;Open INDEX and DICT files. Read in WORDS and LINKS files.
READ: OPEN 7,DSK17 ;prepare to open INDEX for writing new version
ERRXIT {OPEN FAILED ON DSK (12)}
SETZM INDEXF+1
SETZM INDEXF+2
SETZM INDEXF+3
ENTER 7,INDEXF ;INDEX file
JRST PAUSE2 ;FILER must be writing INDEX now...wait a bit
AGAIN4: OPEN 3,DSK17 ;open DICT file in Read Alter mode
ERRXIT {OPEN FAILED ON DSK (14)}
SETZM DICTF+3
LOOKUP 3,DICTF
JRST PAUSE4
SETZM DICTF+1
SETZM DICTF+2
SETZM DICTF+3
ENTER 3,DICTF
JRST PAUSE4
SETZM DICREC ;indicate that no DICT rec is in core
SETZM MLTREC ;indicate that no mult rec of DICT is in core
SETOM CATNBR
PUSHJ P,GTDICT
OPEN 4,DSK17 ;read in WORDS
ERRXIT {OPEN FAILED ON DSK (16)}
SETZM WORDSF+3
LOOKUP 4,WORDSF
ERRXIT {LOOKUP FAILED ON FILE: WORDS (18)}
IN 4,WCMD
JRST .+2
ERRXIT {IN UUO FAILED DURING ATTEMPT TO READ IN FILE: WORDS (20)}
RELEAS 4,
OPEN 5,DSK17 ;read in LINKS
ERRXIT {OPEN FAILED ON DSK (22)}
SETZM LINKSF+3
LOOKUP 5,LINKSF
ERRXIT {LOOKUP FAILED ON FILE: LINKS (24)}
IN 5,LCMD
JRST .+2
ERRXIT {IN UUO FAILED DURING ATTEMPT TO READ IN FILE: LINKS (26)}
RELEAS 5,
;Look for keywords in story. Link up any that are found.
SETZM LINKS+1 ;init back ptr from new story to LINKS
SETZ WD, ;point to header of sorted list
MOVEI DICTWD,2 ;point to first word in dictionary
MOVEM DICTWD,DICPTR
NEXTWD: SETZM CATFLG ;clear the "categorized" flag
HLRZ WD,SORDID(WD) ;get link to next word in list
TRZ WD,700000 ;zero out the length field
JUMPE WD,DONE ;a zero link means end of list
HLRO A,SORDID(WD) ;get length this word
ASH A,-17 ;right adjust the length
HRRZ TXTPTR,SORDID(WD) ;get the pointer to the text of this word
MOVE PART1,1(TXTPTR)
MOVE PART2,2(TXTPTR)
MOVE PART3,3(TXTPTR) ;load the parts of this word into ACs
MOVE PART4,4(TXTPTR)
SUB TXTPTR,A ;advance TXTPTR to next consecutive word in TEXT
CAMGE A,[-4]
HRREI A,-4 ;prepare to compare at most 4 parts of current word
MOVEM A,LEN ;save pseudo length of this word
JRST .+2
NXTDWD: PUSHJ P,RDDICT
HLRZ FIRST,DICT(DICTWD) ;get pointer to text of dictionary word
MOVE A,LEN ;put length of current word into A
CAME PART1,WORDS(FIRST) ;compare parts until inequality or
JRST CK1 ; until no more parts left in
AOJGE A,EQUAL ; which case words must be equal
CAME PART2,WORDS+1(FIRST)
JRST CK2
AOJGE A,EQUAL
CAME PART3,WORDS+2(FIRST)
JRST CK3
AOJGE A,EQUAL
CAMN PART4,WORDS+3(FIRST)
JRST EQUAL
CK4: CAMG PART4,WORDS+3(FIRST) ;when a part is unequal, see which word is less
JRST NEXTWD ;Word not in dictionary
JRST NXTDWD ;Get next dictionary word
CK3: CAMG PART3,WORDS+2(FIRST)
JRST NEXTWD
JRST NXTDWD
CK2: CAMG PART2,WORDS+1(FIRST)
JRST NEXTWD
JRST NXTDWD
CK1: CAMG PART1,WORDS(FIRST)
JRST NEXTWD
JRST NXTDWD
;Link up keyword in story.
EQUAL: HLRZ A,DICT+1(DICTWD) ;is current dict word part of a mult key?
JUMPE A,CATEG ;no. categorize current story by dict wd
PUSH P,MLTREC ;save record nbr of current mult key
PUSH P,MLTPTR
PUSH P,DICTWD ;save current dict word
MOVE DICTWD,A ;get ptr to next word in multiple key
ADDI WD,1 ;move ptr to following word in story
MOVE PART1,1(TXTPTR) ;load the parts of the story word into ACs
MOVE PART2,2(TXTPTR)
MOVE PART3,3(TXTPTR)
MOVE PART4,4(TXTPTR)
HLRO A,SORDID(WD) ;get length of this story word
ASH A,-17 ;shift length into low order bits of AC
SUB TXTPTR,A ;move TXTPTR to the NEXT story word
CAMGE A,[-4] ;compare at most 4 parts of the story
HRREI A,-4 ; word and the dict word
MOVEM A,LEN ;save pseudo length of story word
BRO: PUSHJ P,GETMLT ;make sure the DICT rec containing the mult is in core
MOVE A,LEN ;put length of story word in AC A for counting
HLRZ FIRST,DICT(DICTWD) ;get ptr to first part of dict wd in WORDS
CAME PART1,WORDS(FIRST) ;compare story word and dict word
JRST NOTSAM
AOJGE A,EQUAL ;A=0 means we are at end of story word
CAME PART2,WORDS+1(FIRST)
JRST NOTSAM
AOJGE A,EQUAL
CAME PART3,WORDS+2(FIRST)
JRST NOTSAM
AOJGE A,EQUAL
CAMN PART4,WORDS+2(FIRST)
JRST EQUAL
NOTSAM: HRRZ DICTWD,DICT+2(DICTWD) ;story word not same as dict wd. get ptr to
JUMPN DICTWD,BRO ; mult bro. if zero, then no bro exists.
JRST EQ2
;categorize story by longest keyword that matched.
CATEG: SKIPN AVAIL,LINKS ;any slots available in LINKS file?
JRST EQ2 ;no!!
CAIL DICTWD,200
PUSHJ P,[MOVE A,GUDREC ;make sure correct mult rec is in core
JRST CHKREC]
HRRE A,DICT+1(DICTWD) ;get pointer to first slot for current word
JUMPL A,EQ2 ;is this a legal keyword?
SKIPGE B,CATNBR
JRST EQ4
CAMN DICTWD,KEYS(B) ;has this keyword already categorized story?
JRST EQ2 ;yes
SOJGE B,.-2
EQ4: AOS B,CATNBR ;prepare to save ptr to keyword entry in
CAIL B,NKEYS ; KEYS array to prevent duplication
JRST EQ2 ;no more room in KEYS array. dont use keyword
MOVEM DICTWD,KEYS(B) ;insure that this keyword won't be used again
SETOM CATFLG ;yes. set "categorized" flag
SETOM WRFLAG ;mark current DICT rec as changed
MOVE B,LINKS(AVAIL) ;remove available slot from free slot list
MOVEM B,LINKS ; and update free-slot list header
JUMPE A,EQ1 ;a zero pointer means no such slot exists
HRRM AVAIL,LINKS(A) ;store back ptr to new slot in old slot
HRLM A,LINKS(AVAIL) ;store ptr to old slot in new slot
EQ1: CAIL DICTWD,200 ;is this a mult word key?
SKIPA A,MLTPTR ;yes. get negated ptr to mult word key
MOVN A,DICPTR ;no. negate dictwd pointer for storing it
HRRM A,LINKS(AVAIL) ;store negated dict pointer in new slot
HRRM AVAIL,DICT+1(DICTWD) ;store ptr to new slot in dict entry for current word
MOVE A,LINKS+1 ;get back ptr to last slot in current story
MOVEM A,LINKS+1(AVAIL) ;store that ptr in new slot
MOVE B,UNDUN ;load ptr to current story
HRRM B,LINKS+1(AVAIL) ;store ptr to current story in new slot
HRLZM AVAIL,LINKS+1 ;update back ptr to last slot for story (new slot)
EQ2: CAMN P,INITPD ;have all multiple word entries been popped?
JRST NEXTWD ;yes
POP P,DICTWD ;no. pop next one off stack
SUBI WD,1 ; and readjust ptr to word in story
POP P,MLTPTR
POP P,GUDREC ;retrieve mult rec nbr for this mult key
SKIPE CATFLG ;has the current keyword been categorized?
JRST EQ2 ;yes. just pop rest of mult word entries.
JRST CATEG ;no. try to categorize it now.
;Write out new versions of files.
DONE: USETO 3,@DICREC ;select the appropriate record for writing out dict
SKIPE WRFLAG ;has the record of DICT that is in core been changed?
OUT 3,DCMD ;yes. write out the new values.
JRST .+2
ERRXIT {OUT UUO FAILED TO WRITE OUT RECORD OF DICT (27)}
SKIPN MLTREC ;is there a mult rec of DICT in core?
JRST DUN2 ;no
USETO 3,@MLTREC ;yes. select correct rec for writing it out
OUT 3,MCMD ;write out last mult rec that is in core
JRST .+2
ERRXIT {OUT UUO FAILED TO WRITE OUT LAST MULT REC OF DICT (27.5)}
DUN2: OPEN 10,DSK17 ;prepare to write out LINKS
ERRXIT {OPEN FAILED ON DSK (28)}
SETZM LINKSF+1
SETZM LINKSF+2
SETZM LINKSF+3
ENTER 10,LINKSF
ERRXIT {ENTER FAILED ON FILE: LINKS (30)}
OUT 10,LCMD ;write out LINKS file
JRST .+2
ERRXIT {OUT UUO FAILED DURING ATTEMPT TO WRITE OUT FILE: LINKS (32)}
FINISH: MOVE B,UNDUN ;get ptr to current (UNDUN story)
OPEN 6,DSK17 ;prepare to open INDEX for reading old version
ERRXIT {OPEN FAILED ON DSK (34)}
SETZM INDEXF+3
LOOKUP 6,INDEXF ;INDEX file
ERRXIT {LOOKUP FAILED ON FILE: INDEX (36)}
IN 6,XCMD ;read in entire INDEX file
JRST .+2
ERRXIT {IN UUO FAILED DURING ATTEMPT TO READ IN FILE: INDEX (38)}
RELEAS 6, ;old version of INDEX that was just read
SKIPE MISSIN ;should new parameters be written out for this story?
JRST FIN3 ;no
MOVE A,LINKS+1 ;load back ptr to last slot for current story
HLLM A,INDEX(B) ;store this back ptr in index info for this story
MOVE A,TAKEFG
HRRM A,INDEX(B) ;put first-take flag into index for this story
JUMPE PREV,FIN3 ;ACs WD and PREV are the same. so if the current
FIN1: HRRE A,INDEX(PREV) ; story is to be linked up with an earlier
JUMPLE A,FIN2 ; one, PREV will be non-zero. if the current
MOVE PREV,A ; story is not to be linked up with an
JRST FIN1 ; earlier story WD (PREV) will be zero
FIN2: HRRM A,INDEX(B) ;put whatever was in the old story's link in the new story's
HRRM B,INDEX(PREV) ;put a link to the new story in the old story's link
FIN3: ADDI B,XSIZE ;advance UNDUN
CAIL B,XLEN
MOVEI B,SPECS
MOVEM B,UNDUN ;put new value of UNDUN back into INDEX array
OUT 7,XCMD ;write out new INDEX file
JRST .+2
ERRXIT {OUT UUO FAILED DURING ATTEMPT TO WRITE OUT FILE: INDEX (40)}
RELEAS 10, ;LINKS file
RELEAS 3, ;DICT file
RELEAS 7, ;new version of INDEX file
SKIPE MISSIN ;check if the story to have been catagorized was missing
ERRXIT {A STORY SEEMINGLY DISAPPEARED BEFORE BEING CATAGORIZED (41)}
; OUTSTR [ASCIZ / FINISHED! /]
SKIPE LINKS ;have we run out of slots in LINKS?
JRST MORE ;no
JUMPN PREV,MORE ;prev ≠ 0 means LINKS wasn't read in, so we are ok
ERRXIT {NO AVAILABLE SLOTS IN LINKS (42)};LINKS was read in and there are no more slots
;Subroutines: RDDICT, GTDICT, PAUSE1-4, DIGEST, DONTDO, GONE.
RDDICT: SETOM CATNBR ;indicate no similar keywords used
MOVEI A,2 ;advance to next entry in dictionary by incrementing
ADDM A,DICPTR ; DICPTR and DICTWD by 2
ADDI DICTWD,2
CAIGE DICTWD,200 ;has DICTWD gone beyond the record that is in core?
POPJ P, ;no. return.
SKIPN WRFLAG ;has the DICT record in core been changed?
JRST GTDICT ;no
USETO 3,@DICREC ;yes. select correct record for writing it out
OUT 3,DCMD ;write out the new values.
JRST .+2
ERRXIT {OUT UUO FAILED WHEN WRITING OUT ONE RECORD OF DICT (43)}
GTDICT: AOS A,DICREC ;adjust DICREC to the new record number
USETI 3,(A)
IN 3,DCMD ;read in the next record
JRST .+2
ERRXIT {IN UUO FAILED DURING ATTEMPT TO READ IN A RECORD OF THE FILE: DICT (44)}
SETZM WRFLAG ;reset the write flag
SETZ DICTWD, ;set DICTWD to point at beginning of record
POPJ P, ;return
;make sure the record needed for a mult DICT entry, as indicated by DICTWD, is in core
GETMLT: MOVE A,DICTWD
MOVNM DICTWD,MLTPTR ;save negated ptr to this mult word key
TRZ DICTWD,777600 ;zero out record part of DICTWD
ADDI DICTWD,200 ;make DICTWD point to the mult rec of DICT in core
ASH A,-7 ;calculate the number of the mult rec needed in core
ADDI A,1
CHKREC: MOVEM A,GUDREC
CAMN A,MLTREC ;is that record already in core?
POPJ P, ;yes
SKIPN MLTREC ;is any mult rec in core?
JRST GETM ;no
USETO 3,@MLTREC ;yes. select the proper rec nbr for writing it back out
OUT 3,MCMD ;write out the rec that is in core
JRST .+2
ERRXIT {OUT UUO FAILED TO WRITE OUT MULT REC OF DICT (43.7)}
GETM: MOVEM A,MLTREC ;save number of new mult rec to be in core
USETI 3,(A) ;select the correct record to be read in
IN 3,MCMD ;read in a new mult rec
POPJ P, ;return
ERRXIT {IN UUO FAILED TO READ IN MULT REC FROM DICT (43.9)}
PAUSE1: RELEAS 0,
; OUTSTR [ASCIZ / PAUSE-NEWS /]
MOVEI A,2
CALL A,[SIXBIT /SLEEP/]
JRST AGAIN1
PAUSE2: RELEAS 7,
; OUTSTR [ASCIZ / PAUSE-INDEX /]
MOVEI A,2
CALL A,[SIXBIT /SLEEP/]
JRST READ
PAUSE3: RELEAS 1,
MOVEI A,1
CALL A,[SIXBIT /SLEEP/]
JRST AGAIN3
PAUSE4: RELEAS 3,
MOVEI A,2
CALL A,[SIXBIT /SLEEP/]
JRST AGAIN4
;and now, a few kludges...
DONTDO:
DIGEST: SETZ PREV, ;inhibit linking this story with any earlier story
SETOM LINKS ;inhibit error msg about no slots in LINKS
SETZM LINKS+1 ;clear back ptr to LINKS slots for this story
JRST LINKEM ;finish up
GONE: SETOM LINKS ;inhibit error msg about no slot in LINKS
SETOM MISSIN ;set flag indicating that this story was not found
JRST LINKEM ;finish up
;Subroutines: ERROR.
ERROR: SETOM TTYLIN
GETLIN TTYLIN
AOSN TTYLIN
JRST ADDERR
OUTSTR [CRLFS: ASCIZ /
/]
OUTSTR (A) ;job not detached so print out message
OUTSTR CRLFS
MOVE A,SAVEDA
CALLI 1,12 ;EXIT, inhibit file closing
HALT .
ADDERR: CALLI 0 ;RESET
MOVEI B,1
MOVEI C,10
AGAINE: INIT 1,0
SIXBIT /DSK/
XWD ERRBFO,0
HALT .-3
SETZM ERRORF+1
SETZM ERRORF+2
SETZM ERRORF+3
ENTER 1,ERRORF
JRST [RELEAS 1,
SOJLE C,SPLIT
CALL B,[SIXBIT /SLEEP/]
JRST AGAINE]
INIT 2,0
SIXBIT /DSK/
ERRBFI
HALT .-3
SETZM ERRORF+3
LOOKUP 2,ERRORF
JRST COPIED
COPYER: SOSG ERRBFI+2
IN 2,
JRST [ILDB CHAR,ERRBFI+1
JUMPE CHAR,COPIED
SOSG ERRBFO+2
OUT 1,
JRST [IDPB CHAR,ERRBFO+1
JRST COPYER]
FOO: HALT FOO]
STATO 2,20000
HALT .
COPIED: RELEAS 2,
CALL B,[SIXBIT /DATE/]
CALL C,[SIXBIT /TIMER/]
;Write error message on a file with the time, month, and day.
IDIVI C,=60*=3600
IDIVI C+1,=3600
IDIVI C+1,=10
HRLZI AC1,40B24 ;put a blank in AC1
ADDI AC1,60(C+2) ;ONES PLACE OF MINUTES
ROT AC1,-7
ADDI AC1,60(C+1) ;TENS PLACE OF MINUTES
ROT AC1,-7
IDIVI C,=10
ADDI AC1,60(C+1) ;ONES PLACE OF HOURS
ROT AC1,-7
ADDI AC1,60(C) ;TENS PLACE OF HOURS
ROT AC1,-7
IDIVI B,=31
ADDI B+1,1
IDIVI B+1,=10
MOVEI AC2,60(B+2) ;ONES PLACE OF DAY
ROT AC2,-7
ADDI AC2,60(B+1) ;TENS PLACE OF DAY
ROT AC2,-16
ADD AC2,[ASCII /-/] ;PUT "-" BETWEEN MONTH AND DAY
IDIVI B,=12
ADDI B+1,1
IDIVI B+1,=10
ADDI AC2,60(B+2) ;ONES PLACE OF MONTH
ROT AC2,-7
ADDI AC2,60(B+1) ;TENS PLACE OF MONTH
ROT AC2,-7
MOVE BPTR,[POINT 7,AC1]
MOVEI C,=10 ;put 10 chars into output buffer
DAYTIM: ILDB CHAR,BPTR ;output the time, month, and day
SOSG ERRBFO+2
OUT 1,
JRST [IDPB CHAR,ERRBFO+1
SOJG C,DAYTIM
JRST ADDMSG]
HALT .
ADDMSG: HRLI A,440700 ;output error message
MESSAG: ILDB CHAR,A
SOSG ERRBFO+2
OUT 1,
JRST [IDPB CHAR,ERRBFO+1
JUMPN CHAR,MESSAG
JRST CLOSEM]
HALT .
CLOSEM: RELEAS 1,
SPLIT: SKIPE XITFLG ;should DOER exit now?
CALL [SIXBIT /EXIT/] ;yes
MOVEI A,SWAPBK ;no
CALL A,[SIXBIT /SWAP/];get a new version of DOER started up
;Interrupt level module: INTRPT, CHGNAM.
INTRPT: MOVE A,JOBCNI
JFFO A,.+1
CAIN A+1,=19 ;was it an interrupt to set the job name
JRST CHGNAM ;yes. do it.
MOVEM A+1,SVINTR# ;save indicator of the cause of interrupt
CALL [SIXBIT /UWAIT/]
JRST@ 2,[.+1] ;no. get out of user-iot.
CALL [SIXBIT /DEBREAK/]
MOVE A,SVINTR
CAIE A,=9 ;was the interrupt for a parity error?
ERRXIT {UNKNOWN INTERRUPT OCCURRED IN DOER} ;no!
ERRMSG {PARITY ERROR IN DOER} ;yes
CHGNAM: SETZ A, ;zero out job name
CALL A,[SIXBIT /SETNAM/]
SETOM NRDOER ;initialize indicator to one other doer
MOVE A,NAME
CALL A,[SIXBIT /NAMEIN/]
JRST .+2 ;zero or multiple doers exist
CALL [SIXBIT /DISMIS/] ;exactly one other doer exists
SETZM NRDOER ;set indicator to multiple doers
CAIE A,1 ;check error code of NAMEIN
CALL [SIXBIT /DISMIS/] ;multiple doers exist
AOS NRDOER ;set indicator to no other doers
MOVE A,NAME ;set job name
CALL A,[SIXBIT /SETNAM/]
MOVEI A,200000
CALL A,[SIXBIT /INTACM/] ;disable further pdl ov interrupts
CALL [SIXBIT /DISMIS/]
END DOER